home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 23.zip / BS1 part 23 / Hisoft Basic v1.03 disk 2.adf / Drawing Programs / Paint.BAS < prev    next >
BASIC Source File  |  1988-12-02  |  18KB  |  748 lines
  1. Setup:
  2.   Colors=5 : MaxColors=2^Colors-1
  3.   DIM Pointer(4,1),AltColor(4),Colors%(31,2)
  4.   DIM FillPattern%(7),AllPatterns%(8,7),Solid%(1)
  5.   DrawType=1 : DrawColor=1 : FillColor=2 : Mode=1
  6.  
  7.   Solid%(0)=&HFFFF : Solid%(1)=&HFFFF
  8.   FOR x=0 TO 7
  9.     FillPattern%(x)=&HFFFF
  10.     AllPatterns%(0,x)=&HFFFF
  11.   NEXT x
  12.   FOR x=1 TO 8
  13.     FOR y=0 TO 7
  14.       READ AllPatterns%(x,y)
  15.     NEXT y
  16.   NEXT x
  17.  
  18.   DATA 24672,1542,24672,1542,24672,1542,24672,1542
  19.   DATA -13108,13107,-13108,13107,-13108,13107,-13108,13107
  20.   DATA 26214,13107,-26215,-13108,26214,13107,-26215,-13108
  21.   DATA -13108,-26215,13107,26214,-13108,-26215,13107,26214
  22.   DATA -258,-258,-258,0,-4113,-4113,-4113,0
  23.   DATA -8185,-8197,-18019,-20491,-20467,-8197,-8185,-1
  24.   DATA 0,0,1632,4080,4080,2016,384,0
  25.   DATA 960,1984,3520,6592,16320,25024,-3104,0
  26.  
  27.   SCREEN 1,320,200,Colors,1
  28.   WINDOW 2,"AmigaBASIC Draw Program",,16,1
  29.   WINDOW CLOSE 3
  30.   WINDOW CLOSE 4
  31.   WINDOW 2
  32.  
  33.   FOR x=0 TO 31
  34.     READ r,g,b
  35.     PALETTE x,r/16,g/16,b/16
  36.     Colors%(x,0)=r : Colors%(x,1)=g : Colors%(x,2)=b
  37.   NEXT x
  38.  
  39.   DATA 0,0,3, 15,15,15, 0,3,12, 15,0,0
  40.   DATA 0,14,15, 15,0,15, 3,10,1, 15,14,0
  41.   DATA 15,8,0, 10,0,14 ,8,5,0, 11,8,3
  42.   DATA 2,11,0, 15,10,15, 0,0,9, 7,15,0
  43.   DATA 14,12,0, 15,2,3, 0,0,0, 15,11,10
  44.   DATA 0,6,8, 3,3,3, 4,4,4, 5,5,5
  45.   DATA 6,6,6, 7,7,7, 8,8,8, 9,9,9
  46.   DATA 11,11,11, 13,13,13, 0,0,15, 12,15,12 
  47.  
  48. Pulldown:
  49.   MENU 3,0,0,""
  50.   MENU 4,0,0,""
  51.   MENU 1,0,1,"Program"
  52.   MENU 1,1,1,"Draw         "
  53.   MENU 1,2,1,"Color Palette"
  54.   MENU 1,3,1,"Fill Pattern "
  55.   MENU 1,4,1,"Load Screen  "
  56.   MENU 1,5,1,"Save Screen  "
  57.   MENU 1,6,1,"Clear Screen "
  58.   MENU 1,7,1,"End          "
  59.   MENU 2,0,1,"Drawing tools"
  60.   MENU 2,1,2,"  Draw freehand  "
  61.   MENU 2,2,1,"  Draw thick     "
  62.   MENU 2,3,1,"  Points         "
  63.   MENU 2,4,1,"  Spray          "
  64.   MENU 2,5,1,"  Lines          "
  65.   MENU 2,6,1,"  Frame          "
  66.   MENU 2,7,1,"  Box            "
  67.   MENU 2,8,1,"  Connected lines"
  68.   MENU 2,9,1,"  Oval           "
  69.   MENU 2,10,1,"  Fill           "
  70.   MENU 2,11,1,"  Eraser         "
  71.   MENU 2,12,1,"  Text           "
  72.  
  73. MainLoop:
  74.   ON MENU GOSUB MenuSelect
  75.   ON MOUSE GOSUB EvalMouse
  76.   MENU ON
  77.   MOUSE ON
  78.  
  79.   WHILE -1
  80.   WEND
  81.  
  82. MenuSelect:
  83.   Men=MENU(0)
  84.   MenChoice=MENU(1)
  85.   ON Men GOTO Project,DrawTools
  86.  
  87. EvalMouse:
  88.   IF Mode=1 THEN ON DrawType GOSUB DrawThin,DrawThick,Points,Spray,DrawLines,Frame,Box,ConnectedLines,Oval,Fill,Eraser,Text
  89.   IF Mode=2 THEN GOSUB ColorPalette : IF EndOK=1 THEN GOSUB ColorDone
  90.   IF Mode=3 THEN GOSUB DefinePattern : IF EndOK=2 THEN GOSUB PatternDone
  91.   IF Mode=4 THEN GOSUB RGBDef : IF EndOK=3 THEN Mode=2 : GOSUB SelectColor
  92. RETURN
  93.  
  94. Project:
  95.   IF MenChoice=1 THEN GOSUB ColorDone : GOSUB PatternDone
  96.   IF MenChoice=2 THEN GOSUB PatternDone : MENU 2,0,0 : Mode=2 : GOSUB SelectColor
  97.   IF MenChoice=3 THEN GOSUB ColorDone : MENU 2,0,0 : Mode=3 : GOSUB PatternEditor
  98.   IF MenChoice=4 THEN GOSUB ColorDone : GOSUB PatternDone : GOSUB DrawLoad
  99.   IF MenChoice=5 THEN GOSUB ColorDone : GOSUB PatternDone : GOSUB DrawSave
  100.   IF MenChoice=6 AND Mode=1 THEN OK=0 :GOSUB Query : IF OK=1 THEN Adef=0 : AREAFILL: CLS
  101.   IF MenChoice=7 THEN GOSUB ColorDone : GOSUB PatternDone : OK=0 : GOSUB Query : IF OK=1 THEN EndIt 
  102. RETURN
  103.  
  104. DrawTools:
  105.   MENU 2,DrawType,1
  106.   DrawType = MENU (1)
  107.   MENU 2,DrawType,2
  108. RETURN
  109.  
  110. DrawThin:
  111.   Test= MOUSE(0) : x=MOUSE(1) : y=MOUSE(2)
  112.   WHILE MOUSE(0)<>0
  113.     LINE (x,y)-(MOUSE(1),MOUSE(2)),DrawColor 
  114.     x=MOUSE(1) : y=MOUSE(2)
  115.   WEND
  116. RETURN
  117.  
  118. DrawThick:
  119.   Test=MOUSE(0)
  120.   WHILE MOUSE(0)<>0
  121.     x=MOUSE(1) : y=MOUSE(2)
  122.     LINE (x,y)-(x+5,y+5),DrawColor,bf
  123.   WEND
  124. RETURN
  125.  
  126. Points:
  127.   Test=MOUSE(0)
  128.   WHILE MOUSE(0)<>0
  129.     PSET (MOUSE(1),MOUSE(2)),DrawColor
  130.   WEND
  131. RETURN
  132.  
  133. Spray:
  134.   Test=MOUSE(0)
  135.   WHILE MOUSE(0)<>0
  136.     x=MOUSE(1)+14*RND : y=MOUSE(2)+7*RND
  137.     LINE (x,y)-(x,y),DrawColor,bf
  138.   WEND
  139. RETURN
  140.  
  141. DrawLines:
  142.   Test=MOUSE(0)
  143.   x1=MOUSE(3) : y1=MOUSE(4)
  144.   PSET (x1,y1),DrawColor
  145.   WHILE MOUSE(0)<>0
  146.   WEND
  147.   LINE (x1,y1)-(MOUSE(5),MOUSE(6)),DrawColor
  148. RETURN
  149.  
  150. Frame:
  151.   Test=MOUSE(0)
  152.   x1=MOUSE(3) : y1=MOUSE(4)
  153.   Pointer(0,0)=x1 : Pointer(0,1)=y1
  154.   Pointer(1,0)=x1 : Pointer(2,1)=y1
  155.   Value=4
  156.   WHILE MOUSE(0)<>0
  157.     Pointer(3,0)=MOUSE(5)
  158.     Pointer(3,1)=MOUSE(6)
  159.     Pointer(1,1)=Pointer(3,1)
  160.     Pointer(2,0)=Pointer(3,0)
  161.     GOSUB PlacePoint
  162.   WEND
  163.   LINE (x1,y1)-(Pointer(3,0),Pointer(3,1)),DrawColor,b
  164. RETURN
  165.  
  166. Box:
  167.   Test=MOUSE(0)
  168.   x1=MOUSE(3) : y1=MOUSE(4)
  169.   Pointer(0,0)=x1 : Pointer(0,1)=y1
  170.   Pointer(1,0)=x1 : Pointer(2,1)=y1
  171.   Value=4
  172.   WHILE MOUSE(0)<>0
  173.     Pointer(3,0)=MOUSE(5)
  174.     Pointer(3,1)=MOUSE(6)
  175.     Pointer(1,1)=Pointer(3,1)
  176.     Pointer(2,0)=Pointer(3,0)
  177.     GOSUB PlacePoint
  178.   WEND
  179.   LINE (x1,y1)-(Pointer(3,0),Pointer(3,1)),DrawColor,bf
  180. RETURN
  181.  
  182. ConnectedLines:        
  183.   Test=MOUSE(0)
  184.   x1=MOUSE(3) : y1=MOUSE(4)
  185.   IF y1>186 THEN y1=186
  186.   IF x1>311 THEN x1=311
  187.   AREA (x1,y1)
  188.   IF Adef=0 THEN Adef=1 : xa=x1 : ya=y1
  189.   IF Adef<>1 AND x1=xa AND y1=ya THEN DoFill
  190.   Adef=Adef+1 : IF Adef=20 THEN DoFill
  191.   LINE (xa,ya)-(x1,y1),DrawColor
  192.   xa=x1 : ya=y1
  193. RETURN
  194.  
  195. DoFill:
  196.   Adef=0 : COLOR DrawColor,0 : AREAFILL 
  197. RETURN
  198.  
  199. Oval:
  200.   Test=MOUSE(0)
  201.   x1=MOUSE(3) : y1=MOUSE(4)
  202.   Pointer(0,0)=x1 : Pointer(0,1)=y1
  203.   Pointer(1,0)=x1 : Pointer(2,1)=y1
  204.   Pointer(3,0)=x1 : Pointer(4,1)=y1
  205.   Value=5
  206.   WHILE MOUSE(0)<>0
  207.     r1= ABS(x1-MOUSE(5))
  208.     r2= ABS(y1-MOUSE(6))
  209.     Pointer(1,1)=y1-r2 : Pointer(2,0)=x1+r1
  210.     Pointer(3,1)=y1+r2 : Pointer(4,0)=x1-r1
  211.     GOSUB PlacePoint
  212.   WEND
  213.   IF r1=0 THEN r1=.1
  214.   IF r1<r2 THEN Factor=(r2/r1) : r1=r1*Factor : r2=r2*Factor
  215.   CIRCLE (x1,y1),r1,DrawColor,,,(r2/r1)
  216. RETURN
  217.  
  218.  
  219. Fill:
  220. Test=MOUSE(0)
  221. IF Click=0 THEN
  222.   Click=1
  223.   SOUND 440,6,200
  224.   x=MOUSE(1) : y=MOUSE(2)
  225.   RETURN
  226. ELSE
  227.   Click=0
  228.   IF ABS(x-MOUSE(1))<11 AND ABS(y-MOUSE(2))<6 THEN
  229.     PAINT (x,y),FillColor,DrawColor
  230.   ELSE
  231.     SOUND 440,6,200
  232.   END IF
  233. END IF
  234. RETURN
  235.  
  236. Eraser:
  237.   Test=MOUSE(0)
  238.   WHILE MOUSE(0)<>0
  239.     x=MOUSE(1):y=MOUSE(2)
  240.     PATTERN ,Solid%
  241.     LINE (x,y)-(x+10,y+5),0,bf
  242.     PATTERN ,FillPattern%
  243.   WEND
  244. RETURN
  245.  
  246. Text:
  247.   Test=MOUSE(0)
  248.   x=MOUSE(1) : y=MOUSE(2)
  249.   MENU OFF : MOUSE OFF
  250.   MENU 1,0,0 : MENU 2,0,0
  251.   WINDOW 5,"Enter Text:",(0,177)-(311,185),18,1
  252.   CLS
  253.   LINE INPUT Text$
  254.   WINDOW CLOSE 5
  255.   WINDOW 2
  256.   MENU 1,0,1 : MENU 2,0,1
  257.   MENU ON : MOUSE ON
  258.   LOCATE INT(y/8.86)+1,INT(x/10)+1 : COLOR DrawColor,FillColor
  259.   PRINT Text$;
  260.   COLOR DrawColor,0
  261. RETURN
  262.  
  263. PlacePoint:
  264.   FOR x=0 TO Value-1
  265.     xz=Pointer(x,0):yz=Pointer(x,1)
  266.     IF xz<0 THEN xz=0 : Pointer(x,0)=0
  267.     IF xz>311 THEN xz=311 : Pointer(x,0)=311
  268.     IF yz<0 THEN yz=0 : Pointer(x,1)=0
  269.     IF yz>186 THEN yz=186 : Pointer(x,1)=186
  270.     AltColor(x)=POINT(xz,yz)
  271.   NEXT x
  272.   FOR x=0 TO Value-1
  273.     PSET (Pointer(x,0),Pointer(x,1)),-(AltColor(x)=0)
  274.   NEXT x
  275.   FOR x=0 TO Value-1
  276.     PSET (Pointer(x,0),Pointer(x,1)),AltColor(x)
  277.   NEXT x
  278. RETURN
  279.  
  280. SelectColor:
  281.   ColorChoice=0 : EndOK=0
  282.   MOUSE OFF : MENU OFF
  283.   WINDOW 3,"Color Palette",(4,20)-(245,160),18,1
  284.   PATTERN ,Solid%
  285.   FOR x= 1 TO (MaxColors+1)/8
  286.     FOR y= 0 TO 7   
  287.       LINE (y*30,(x-1)*16)-((y+1)*30,x*16),(x-1)*8+y,bf
  288.     NEXT y
  289.   NEXT x
  290.   LINE (10,72)-(50,95),DrawColor,b
  291.   LINE (15,75)-(45,93),DrawColor,bf
  292.   LOCATE 12,2 : COLOR 0,1 : PRINT "Draw";
  293.   LINE (70,72)-(110,95),FillColor,b
  294.   LINE (75,75)-(105,93),FillColor,bf
  295.   LOCATE 12,8 : COLOR 1,0 : PRINT "Fill";
  296.   LINE (135,72)-(235,95),1,b
  297.   LOCATE 10,16: PRINT "Palette";
  298.   LINE (190,109)-(230,132),1,b
  299.   LOCATE 14,21 : PRINT "OK";
  300.   PATTERN ,FillPattern%
  301.   MOUSE ON : MENU ON
  302. RETURN
  303.  
  304.  
  305. ColorPalette:
  306.   Test=MOUSE(0)
  307.   x=MOUSE(3) : y=MOUSE(4)
  308.  
  309.   GOSUB ChooseColor
  310.  
  311.   PATTERN ,Solid%
  312.   LINE (10,72)-(50,95),DrawColor,b
  313.   LINE (15,75)-(45,93),DrawColor,bf
  314.   LINE (70,72)-(110,95),FillColor,b
  315.   LINE (75,75)-(105,93),FillColor,bf
  316.   PATTERN ,FillPattern%
  317.  
  318.   IF WINDOW(0)=3 AND 72<y AND y<95 THEN
  319.     IF 70<x AND x<110 THEN ColorChoice=1
  320.     IF 10<x AND x<50 THEN ColorChoice=0 
  321.     IF 135<x AND x<235 THEN
  322.       PATTERN ,Solid%
  323.       PAINT (137,74),3,1
  324.       PATTERN ,FillPattern%
  325.       GOSUB PaletteDef
  326.       RETURN
  327.     END IF
  328.   END IF
  329.   GOSUB OKCheck
  330.  
  331.   IF ColorChoice=0 THEN
  332.     LOCATE 12,2 : COLOR 0,1 : PRINT "Draw";
  333.     LOCATE 12,8 : COLOR 1,0 : PRINT "Fill";
  334.   ELSE
  335.     LOCATE 12,2 : COLOR 1,0 : PRINT "Draw";
  336.     LOCATE 12,8 : COLOR 0,1 : PRINT "Fill";
  337.   END IF
  338. RETURN
  339.  
  340. PaletteDef:
  341.   IF ColorChoice=0 THEN NewColor=DrawColor ELSE NewColor=FillColor
  342.   PATTERN ,Solid%
  343.   LINE (0,71)-(240,107),0,bf
  344.   COLOR 1,0
  345.   LOCATE 9,2 : PRINT "R";
  346.   LOCATE 10,2 : PRINT "G";
  347.   LOCATE 11,2 : PRINT "B";
  348.   LINE (24,70)-(218,78),1,b
  349.   LINE (24,80)-(218,88),1,b
  350.   LINE (24,90)-(218,98),1,b
  351.   LINE (222,70)-(238,98),NewColor,bf
  352.   Mode=4
  353.   PATTERN ,FillPattern%
  354. RETURN 
  355.  
  356. RGBDef:
  357.   Test=MOUSE(0)
  358.   x=MOUSE(3) : y=MOUSE(4)
  359.   GOSUB ChooseColor
  360.   IF ColorChoice=0 THEN NewColor=DrawColor ELSE NewColor=FillColor
  361.   GOSUB RGBRegulator
  362.   GOSUB OKCheck : IF EndOK=1 THEN EndOK=3
  363.   WHILE MOUSE(0)<>0
  364.     x=MOUSE(1) : y=MOUSE(2)
  365.     IF WINDOW(0)=3 AND x>26 AND x<218 AND y>70 AND y<98 THEN
  366.       Colors%(NewColor,INT((y-71)/8.7))=INT((x-26)/12)
  367.       GOSUB RGBRegulator
  368.     END IF
  369.   WEND
  370. RETURN
  371.  
  372. RGBRegulator:
  373.   PATTERN ,Solid%
  374.   LINE (25+r*12,71)-(37+r*12,77),0,bf
  375.   LINE (25+g*12,81)-(37+g*12,87),0,bf
  376.   LINE (25+b*12,91)-(37+b*12,97),0,bf
  377.   r=Colors%(NewColor,0)
  378.   g=Colors%(NewColor,1)
  379.   b=Colors%(NewColor,2)   
  380.   LINE (25+r*12,71)-(37+r*12,77),1,bf
  381.   LINE (25+g*12,81)-(37+g*12,87),1,bf
  382.   LINE (25+b*12,91)-(37+b*12,97),1,bf
  383.   PALETTE NewColor,r/16,g/16,b/16
  384.   LINE (222,70)-(238,98),NewColor,bf
  385.   PATTERN ,FillPattern%
  386. RETURN
  387.  
  388. ChooseColor:
  389.   IF WINDOW(0)=3 AND x<240 AND y<(2^(Colors+1)) THEN
  390.     fx=INT(x/30) : fy = INT(y/16)
  391.     IF ColorChoice=0 THEN                          
  392.       DrawColor=fy*8+fx
  393.     ELSE
  394.       FillColor=fy*8+fx
  395.     END IF
  396.   END IF
  397. RETURN
  398.  
  399. OKCheck:
  400.   IF x>190 AND x<230 AND y>109 AND y<132 THEN
  401.     PATTERN ,Solid%
  402.     PAINT (192,111),3,1 : EndOK=1
  403.     PATTERN ,FillPattern%
  404.   END IF
  405. RETURN
  406.  
  407. ColorDone:
  408.   MENU 2,0,1 : Mode=1
  409.   WINDOW CLOSE 3
  410.   WINDOW OUTPUT 2
  411. RETURN
  412.  
  413. PatternEditor:
  414.   MOUSE OFF : MENU OFF
  415.   EndOK=0
  416.   WINDOW 4,"Fill Patterns",(54,30)-(300,130),18,1
  417.   LINE (0,0)-(132,66),3,b
  418.  
  419.   FOR x=0 TO 2 
  420.     FOR y=0 TO 2 
  421.       FOR i=0 TO 7: FillPattern%(i)=AllPatterns%(y*3+x,i) : NEXT i
  422.       PATTERN ,FillPattern%
  423.       LINE (144+x*34,y*25)-(175+x*34,23+y*25),1,bf
  424.     NEXT y
  425.   NEXT x
  426.   GOSUB MarkPattern
  427.  
  428.   LINE (5,68)-(65,82),1,b
  429.   LOCATE 9,2 : PRINT "Clear";
  430.   LINE (75,68)-(135,82),1,b
  431.   LOCATE 9,9: PRINT "Inv.";
  432.   LINE (5,85)-(65,100),1,b
  433.   LOCATE 11,2 : PRINT "Load";
  434.   LINE (75,85)-(135,100),1,b
  435.   LOCATE 11,9: PRINT "Save";
  436.   LINE (162,77)-(222,92),1,b
  437.   LOCATE 10,19 : PRINT "OK";
  438.  
  439.   FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT i
  440.   GOSUB DrawPattern
  441.  
  442.   MENU ON : MOUSE ON
  443. RETURN
  444.  
  445. DefinePattern:
  446.   Test=MOUSE(0)
  447.   x=MOUSE(3) : y=MOUSE(4)
  448.   IF WINDOW(0)=4 AND x<132 AND y<66 THEN
  449.     px=INT(x/8.25) : py=INT(y/8.25)
  450.     Bit=FillPattern%(py) AND 2^(15-px)
  451.     IF Bit=0 THEN
  452.       FillPattern=FillPattern%(py) OR 2^(15-px)
  453.     ELSE
  454.       FillPattern=FillPattern%(py) AND (65535&-2^(15-px))
  455.     END IF
  456.     IF FillPattern>32767 THEN FillPattern=FillPattern-65536&
  457.     FillPattern%(py)=FillPattern
  458.     PATTERN ,Solid%
  459.     LINE (px*8+4,py*8+2)-(px*8+9,py*8+8),-(Bit=0),bf
  460.     PATTERN ,FillPattern%
  461.     y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
  462.     LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
  463.     FOR i=0 TO 7 : AllPatterns%(PtrnNumber,i)=FillPattern%(i) : NEXT i
  464.     RETURN
  465.   END IF 
  466.   IF WINDOW(0)=4 AND x>142 AND x<244 AND y<75 THEN
  467.     px=INT((x-143)/34) : py=INT(y/25)
  468.     IF px+py*3=PtrnNumber THEN RETURN
  469.     PtrnNumber=px+py*3
  470.     FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT i
  471.     GOSUB MarkPattern
  472.     GOSUB DrawPattern
  473.     PATTERN ,FillPattern%
  474.     RETURN
  475.   END IF 
  476.  
  477.   IF WINDOW(0)=4 AND x<222 AND x>162 AND y<93 AND y>76 THEN
  478.     PATTERN ,Solid%
  479.     PAINT (164,78),2,1
  480.     PATTERN ,FillPattern%
  481.     EndOK=2 : RETURN
  482.   END IF 
  483.  
  484.   IF WINDOW(0)=4 AND x<135 AND y>68 AND y<100 THEN
  485.     PATTERN ,Solid%
  486.     IF x<66 AND x>4 AND y<82 THEN
  487.       PAINT (6,69),2,1
  488.       LINE (1,1)-(131,65),0,bf
  489.       FOR i=0 TO 7 : AllPatterns%(PtrnNumber,i)=0 : FillPattern%(i)=0 : NEXT
  490.       PAINT (6,69),0,1
  491.       PATTERN ,FillPattern%
  492.       y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
  493.       LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
  494.     END IF 
  495.     IF x<136 AND x>74 AND y<82 THEN
  496.       PAINT (76,69),2,1
  497.       FOR i=0 TO 7
  498.         FillPattern%(i)=FillPattern%(i) XOR &HFFFF
  499.         AllPatterns%(PtrnNumber,i)=FillPattern%(i)
  500.       NEXT i
  501.       GOSUB DrawPattern
  502.       PAINT (76,69),0,1
  503.       PATTERN ,FillPattern%
  504.       y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
  505.       LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
  506.     END IF
  507.     IF x<66 AND x>4 AND y>84 THEN GOSUB PtrnLoad
  508.     IF x<135 AND x>75 AND y>84 THEN GOSUB PtrnSave
  509.   END IF
  510. RETURN
  511.  
  512. MarkPattern:
  513.   y1=INT(AltPattern/3) : x1=AltPattern-y1*3     
  514.   LINE (143+x1*34,y1*25-1)-(176+x1*34,24+y1*25),0,b
  515.   y1=INT(PtrnNumber/3) : x1=PtrnNumber-y1*3
  516.   LINE (143+x1*34,y1*25-1)-(176+x1*34,24+y1*25),3,b
  517.   AltPattern=x1+y1*3
  518. RETURN
  519.  
  520. DrawPattern:
  521.   MOUSE OFF : MENU OFF
  522.   PATTERN ,Solid%
  523.   LINE (1,1)-(131,65),0,bf 
  524.   FOR y=0 TO 7
  525.     FOR x=0 TO 15
  526.       Bit=FillPattern%(y) AND 2^(15-x)
  527.       IF Bit<>0 THEN LINE (x*8+4,y*8+2)-(x*8+9,y*8+8),1,bf
  528.     NEXT x
  529.   NEXT y
  530.   PATTERN ,FillPattern%
  531.   MOUSE ON : MENU ON
  532. RETURN
  533.  
  534. PtrnLoad:
  535.   MOUSE OFF : MENU OFF
  536.   PAINT (6,86),2,1
  537.   GOSUB EnterName
  538.   IF Nam$="" THEN EndPtrnLoad
  539.   OPEN Nam$ FOR INPUT AS 1
  540.     FOR x=0 TO 8
  541.       FOR y=0 TO 7
  542.         AllPatterns%(x,y)=CVI(INPUT$(2,1))
  543.       NEXT y
  544.     NEXT x
  545.   CLOSE 1
  546.  
  547. EndPtrnLoad:
  548.   WINDOW CLOSE 5 : WINDOW 4
  549.   PAINT (6,86),0,1
  550.   MOUSE ON : MENU ON
  551.   FOR x=0 TO 8
  552.     FOR y=0 TO 7
  553.       FillPattern%(y)=AllPatterns%(x,y)
  554.       PATTERN ,FillPattern%
  555.       y1=INT(x/3) : x1=x-y1*3
  556.       LINE (144+x1*34,y1*25)-(175+x1*34,23+y1*25),1,bf
  557.     NEXT y
  558.   NEXT x
  559.   FOR i=0 TO 7 : FillPattern%(i)=AllPatterns%(PtrnNumber,i) : NEXT
  560.   GOSUB DrawPattern
  561. RETURN
  562.  
  563. PtrnSave:
  564.   MOUSE OFF : MENU OFF
  565.   PAINT (78,86),2,1
  566.   GOSUB EnterName
  567.   IF Nam$="" THEN EndPtrnLoad
  568.   OPEN Nam$ FOR OUTPUT AS 1
  569.     FOR x=0 TO 8
  570.       FOR y=0 TO 7
  571.         PRINT #1,MKI$(AllPatterns%(x,y));
  572.       NEXT y
  573.     NEXT x
  574.   CLOSE 1
  575.  
  576. EndPtrnSave:
  577.   WINDOW CLOSE 5 : WINDOW 4
  578.   PAINT (78,86),0,1
  579.   MOUSE ON : MENU ON
  580. RETURN
  581.  
  582. PatternDone:
  583.   MENU 2,0,1 : Mode=1
  584.   WINDOW CLOSE 4
  585.   WINDOW OUTPUT 2
  586.   PATTERN ,FillPattern%
  587. RETURN
  588.  
  589. DrawLoad:
  590.   MENU 2,0,0 : MENU 1,0,0
  591.   MENU OFF : MOUSE OFF
  592.   GOSUB EnterName
  593.   WINDOW CLOSE 5
  594.   WINDOW 2
  595.   IF Nam$="" THEN EndLoad 
  596.   OPEN Nam$ FOR INPUT AS 1
  597.     Form$=INPUT$(4,1)
  598.     Length=CVL(INPUT$(4,1))
  599.     IF INPUT$(4,1)<>"ILBM" THEN BEEP : GOTO EndLoad
  600.  
  601. ReadData:
  602.     IF EOF(1) THEN EndLoad
  603.     Chunk$=INPUT$(4,1)
  604.     Length=CVL(INPUT$(4,1))
  605.     IF INT(Length/2)<>(Length/2) THEN Length=Length+1
  606.     IF Chunk$="BMHD" THEN BMHeader
  607.     IF Chunk$="CMAP" THEN ColorMap
  608.     IF Chunk$="BODY" THEN BodyMap
  609.     Dummy$=INPUT$(Length,1)
  610.   GOTO ReadData
  611.  
  612. BMHeader:  
  613.     xd=CVI(INPUT$(2,1))
  614.     IF xd>320 THEN EndLoad
  615.     yd=CVI(INPUT$(2,1))
  616.     IF yd>200 THEN EndLoad
  617.     Dummy$=INPUT$(4,1)
  618.     BitPlane=ASC(INPUT$(1,1))
  619.     Dummy$=INPUT$(11,1)
  620.     Addr=PEEKL(WINDOW(8)+4)+8
  621.     FOR x=0 TO BitPlane-1
  622.       PlaneAddr(x)=PEEKL(Addr+4*x)
  623.     NEXT x
  624.   GOTO ReadData
  625.     
  626. ColorMap:
  627.     FOR x=0 TO (Length/3)-1
  628.       r=(ASC(INPUT$(1,1)) AND 240)/16
  629.       g=(ASC(INPUT$(1,1)) AND 240)/16
  630.       b=(ASC(INPUT$(1,1)) AND 240)/16
  631.       PALETTE x,r/16,g/16,b/16
  632.       Colors%(x,0)=r : Colors%(x,1)=g : Colors%(x,2)=b
  633.     NEXT x
  634.     IF INT(Length/3)<>(Length/3) THEN Dummy$=INPUT$(1,1)
  635.   GOTO ReadData
  636.     
  637. BodyMap:
  638.     FOR y1=0 TO 199
  639.       FOR b=0 TO BitPlane-1
  640.         IF b<Colors THEN
  641.           FOR x1=0 TO 9
  642.             POKEL PlaneAddr(b)+4*x1+40*y1,CVL(INPUT$(4,1))
  643.           NEXT x1
  644.         ELSE
  645.           Dummy$=INPUT$(40,1)
  646.         END IF
  647.       NEXT b
  648.     NEXT y1
  649.   GOTO ReadData      
  650.  
  651. EndLoad:
  652.   CLOSE 1
  653.   MENU ON : MOUSE ON
  654.   MENU 1,0,1 : MENU 2,0,1
  655. RETURN
  656.  
  657. DrawSave:
  658.   MENU 2,0,0 : MENU 1,0,0
  659.   MENU OFF : MOUSE OFF
  660.   GOSUB EnterName
  661.   WINDOW CLOSE 5
  662.   WINDOW 2
  663.   IF Nam$="" THEN EndSave
  664.   OPEN Nam$ FOR OUTPUT AS 1 LEN=FRE(0)-500
  665.     PRINT #1,"FORM";
  666.     PRINT #1,MKL$(156+8000*Colors);
  667.     PRINT #1,"ILBM";
  668.     PRINT #1,"BMHD";MKL$(20);
  669.     PRINT #1,MKI$(320);MKI$(200);
  670.     PRINT #1,MKL$(0);
  671.     PRINT #1,CHR$(Colors);
  672.     PRINT #1,CHR$(0);MKI$(0);MKI$(0);
  673.     PRINT #1,CHR$(10);CHR$(11);
  674.     PRINT #1,MKI$(320);MKI$(200);
  675.     
  676.     PRINT #1,"CMAP";MKL$(96); 
  677.     FOR x=0 TO 31
  678.       PRINT #1,CHR$(Colors%(x,0)*16);
  679.       PRINT #1,CHR$(Colors%(x,1)*16);
  680.       PRINT #1,CHR$(Colors%(x,2)*16);
  681.     NEXT x
  682.     
  683.     PRINT #1,"BODY";MKL$(8000*Colors);
  684.     Addr=PEEKL(WINDOW(8)+4)+8
  685.     FOR x=0 TO Colors-1
  686.       PlaneAddr(x)=PEEKL(Addr+4*x)
  687.     NEXT x
  688.     FOR y1=0 TO 199
  689.       FOR b=0 TO Colors-1
  690.         FOR x1=0 TO 9 
  691.           PRINT#1,MKL$(PEEKL(PlaneAddr(b)+4*x1+40*y1));
  692.         NEXT x1
  693.       NEXT b
  694.       PAddr=PlaneAddr(0)+40*y1
  695.       POKE PAddr,PEEK(PAddr) AND 63
  696.       POKE PAddr+39,PEEK(PAddr+39) AND 252
  697.     NEXT y1
  698.     
  699.     PRINT #1,"CAMG";MKL$(4);
  700.     PRINT #1,MKL$(16384);
  701.   CLOSE 1
  702.     
  703. EndSave:
  704.   MENU ON : MOUSE ON
  705.   MENU 1,0,1 : MENU 2,0,1
  706. RETURN
  707.  
  708. EnterName:
  709.   Altname$=Nam$
  710.   WINDOW 5,"Enter Name:",(0,80)-(311,88),0,1
  711.   CLS
  712.   LINE INPUT Nam$
  713.   IF Nam$= "=" OR Nam$="*" THEN Nam$=Altname$
  714. RETURN
  715.  
  716. Query:
  717.   MENU 1,0,0 : MENU 2,0,0
  718.   MENU OFF : MOUSE OFF
  719.   WINDOW 5,"CAUTION!",(43,70)-(270,120),0,1
  720.   COLOR 0,1 : CLS : LOCATE 2,2
  721.   PRINT "Do you really want to"
  722.   PRINT " lose your picture?"
  723.   PATTERN ,Solid%
  724.   LOCATE 5,10 : PRINT "Yes";
  725.   LOCATE 5,17 : PRINT "No";
  726.   LINE (77,31)-(127,46),0,b
  727.   LINE (145,31)-(195,46),0,b
  728.   SOUND 880,6,100
  729. Pause:
  730.   Test=MOUSE(0)
  731.   WHILE MOUSE(0)=0
  732.     x=MOUSE(1) : y=MOUSE(2)
  733.   WEND
  734.   IF (y<46 AND y>31) THEN
  735.     IF (x<127 AND x>77) THEN PAINT (79,33),3,0 : OK=1 : GOTO EndQuery 
  736.     IF (x<195 AND x>145) THEN PAINT (147,33),3,0 : OK=0 : GOTO EndQuery
  737.   END IF
  738.   GOTO Pause 
  739. EndQuery:
  740.   MENU ON : MOUSE ON : MENU 1,0,1 : MENU 2,0,1
  741.   WINDOW CLOSE 5 : WINDOW 2
  742. RETURN
  743.  
  744. EndIt:
  745.   MENU RESET
  746.   SCREEN CLOSE 1
  747. END
  748.